perm filename PCODE.SAI[PNT,HE]4 blob
sn#478466 filedate 1979-09-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00003 00003 ! frcpcode
C00006 00004 ! pdp10 routines: $afxpcode,$ufxpcode,$asgpcode,$coordpcode
C00009 00005 ! printing: prpcode,prvpcode,abortpcode,promptpcode,ddt
C00011 00006 ! motion:$centerpcode,$movepcode,$drivepcode
C00015 00007 ! control pcodes: if,for,while,do,case
C00020 00008 ! cobegpcode
C00023 00009 ! arrdclpcode,prcdclpcode,rtnpcode,smpdclpcode
C00027 00010 ! load,dump pcodes
C00030 00011 ! wrist,setbase,gather,rforce,setstf,vt05pcode,sigwait
C00032 ENDMK
C⊗;
ENTRY;
BEGIN "PCODE"
COMMENT Module which produces the pcode interpretation of the
relevant instructions ;
DEFINE $$PRGID=TRUE; DEFINE $PCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
! frcpcode;
INTERNAL PROCEDURE $FFRCPCODE(REFERENCE RPTR(EXPR$)HEADER,HEAD,TAIL;
RPTR(EXPR$)EXP,ACTION;INTEGER BITS,DEVBITS,OFFSET);
BEGIN
RPTR(EXPR$)ARRAY F[1:9]; RPTR(SYMBOL)C; INTEGER I,IPC;
F[1]←EXPR$2(XGTBLK);
F[2]←EXPR$3(XAGTVAL,SYMBOL:INDEX[C←CHECK("NILTRANS",#TR)],
SYMBOL:OFFSET[C]); ! expression for trans;
F[3]←EXPR$2(XTFRCST,DEVBITS);
F[4]←EXP;
F[5]←EXPR$1(XCMFORCE);
F[6]←ACTION;
F[7]←EXPR$1(XCMDONE);
EXPR$:BODY[F[1]][2]←EXPR$OFF(F,2,7)-1;
IPC←-1;
F[8]←EXPR$1(5); ! insert it into 5 places from here;
FOR I←XMVAR,5,1,3,IPC,0,BITS,0 DO IPUSH(I);
F[9]←βEXPR$;
HEADER←$AAPPEND(F);
HEAD←EXPR$2(XCMENBL,OFFSET);
TAIL←EXPR$2(XCMDSBL,OFFSET);
END;
INTERNAL RPTR(EXPR$)PROCEDURE $FRCPCODE(RPTR(EXPR$)E,EXP,ACTION;INTEGER BITS,DEVBITS);
BEGIN
RPTR(EXPR$)ARRAY F[1:10]; RPTR(SYMBOL)C; INTEGER I,IPC;
F[1]←EXPR$2(XGTBLK);
F[2]←EXPR$3(XAGTVAL,SYMBOL:INDEX[C←CHECK("NILTRANS",#TR)],
SYMBOL:OFFSET[C]); ! expression for trans;
F[3]←EXPR$2(XTFRCST,DEVBITS);
F[4]←EXP;
F[5]←$APPEND(EXPR$1(XCMFORCE),$APPEND(ACTION,EXPR$1(XCMDONE)));
EXPR$:BODY[F[1]][2]←EXPR$OFF(F,2,5)-1;
IPC←-1;
F[6]←EXPR$1(5); ! insert it into 5 places from here;
FOR I←XMVAR,5,1,3,IPC,0,BITS,0 DO IPUSH(I);
F[7]←βEXPR$;
F[8]←EXPR$2(XCMENBL,$TMPOFF);
F[9]←E;
F[10]←EXPR$2(XCMDSBL,$TMPOFF);
RETURN($AAPPEND(F));
END;
! pdp10 routines: $afxpcode,$ufxpcode,$asgpcode,$coordpcode;
INTERNAL RPTR(EXPR$) PROCEDURE $AFXPCODE(RPTR(EXPR$)SON,DAD; INTEGER AFFTYPE;
RPTR(EXPR$)E1);
BEGIN
INTEGER AFFCODE;
RPTR(EXPR$)EE; RPTR(EXPR$) ARRAY E[1:4];
AFFCODE←IF AFFTYPE≠#RGDLK THEN #NONRGD ELSE 0;
IF E1 THEN E[1]←E1
ELSE BEGIN E[1]←EXPR$1(XNOOP);AFFCODE←AFFCODE+'100000; END;
E[2]←DAD;
E[3]←SON;
E[4]←EXPR$2(XPAFFIX,AFFCODE);
EE←$AAPPEND(E);
RETURN(EE);
END;
INTERNAL RPTR(EXPR$) PROCEDURE $UFXPCODE(RPTR(EXPR$)S,D);
BEGIN RPTR(EXPR$)ARRAY E[1:3];
E[1]←D;
E[2]←S;
E[3]←EXPR$1(XPUNFIX);
RETURN($AAPPEND(E));
END;
INTERNAL RPTR(EXPR$) PROCEDURE $ASGPCODE(RPTR(EXPR$) LHS,RHS);
BEGIN
RPTR(EXPR$)ARRAY PTR[1:3];
PTR[1]←RHS; ! compute the expression ;
PTR[2]←LHS; ! variable reference ;
PTR[3]←EXPR$1(XCHNGS);
$DISPLAYLIST[EXPR$:TYPE[LHS]]←NULL;
RETURN($AAPPEND(PTR));
END;
INTERNAL RPTR(EXPR$) PROCEDURE $COORDPCODE(RPTR(EXPR$)E1,E2; INTEGER ELEMENT,TYPE);
BEGIN
RPTR(EXPR$)ARRAY PTR[1:3];
PTR[1]←E2; ! compute the value;
PTR[2]←E1; ! put reference of id on the interpreter stack;
CASE TYPE OF
BEGIN
[#SC] PTR[3]←EXPR$2(XCHCMP,ELEMENT);
[#VT] PTR[3]←EXPR$1(XCHTPOS);
[#RT] PTR[3]←EXPR$1(XCHTORIENT)
END;
RETURN($AAPPEND(PTR));
END;
! printing: prpcode,prvpcode,abortpcode,promptpcode,ddt;
INTERNAL RPTR(EXPR$) PROCEDURE $PRVPCODE(RPTR(EXPR$)E);
RETURN($APPEND(E,EXPR$2(XPRVAL,EXPR$:TYPE[E]),EXPR$:TYPE[E]));
INTERNAL RPTR(EXPR$)PROCEDURE $PRPCODE(STRING S);
IF LENGTH(S)=1 THEN RETURN(EXPR$2(XPRNTC,LOP(S)))
ELSE
BEGIN
INTEGER I;
IPUSH(XPRNTI); ! push string immediate pcode ;
IPUSH((LENGTH(S)+2)DIV 2); ! push number of words ;
DO IPUSH(LOP(S)+ (I←LOP(S)) LSH 8) UNTIL I=0;
RETURN(βEXPR$);
END;
INTERNAL RPTR(EXPR$)PROCEDURE $ABORTPCODE;
RETURN(EXPR$1(XABORT));
INTERNAL RPTR(EXPR$)PROCEDURE $PROMPTPCODE;
RETURN(EXPR$1(XPROMPT));
INTERNAL RPTR(EXPR$) PROCEDURE $DDTPCODE;
RETURN(EXPR$1(XDDT));
! motion:$centerpcode,$movepcode,$drivepcode;
PRELOAD_WITH '100000,'40000,'20000,'10000,'4000,'2000,'1000,
'400,'200,'100,'40,'20,'10,'4;
INTEGER ARRAY JT_CODE[0:1,1:7];
INTERNAL RPTR(EXPR$)PROCEDURE $DRIVEPCODE(INTEGER COLOR;STRING HOW;
INTEGER JOINT;RPTR(EXPR$)SCAL);
BEGIN RPTR(EXPR$)E;
INTEGER I;
FOR I←XCHNGE,$TSCOFF,XRJMP,9,
JT_CODE[COLOR,JOINT],0,0,0, $TSCOFF,0,0,0,
(IF EQU(HOW,"BY") THEN XRTDDRIVE ELSE XRTADRIVE),
-9,
(IF 1≤JOINT≤6
THEN IF COLOR=BLUE THEN BARM_MECH
ELSE YARM_MECH
ELSE IF COLOR=BLUE THEN BHAND_MECH
ELSE YHAND_MECH),0,5,-1
DO IPUSH(I); ! extra zeroes as in movepcode;
E←$APPEND(SCAL,βEXPR$);
RETURN(E);
END;
INTERNAL RPTR(EXPR$)PROCEDURE $MOVEPCODE(RPTR(SYMBOL)S1,S2;
RPTR(EXPR$)ARRAY FDESTS; INTEGER NFDEST);
BEGIN
RPTR(EXPR$) ARRAY BDESTS[0:NFDEST],PTR[1:4];
RPTR(EXPR$) PPTR;
INTEGER I,J,INDEX;
J←$TTROFF;
GPUSH(S1);
IPUSH(XTINVRT);
GPUSH(S2);
FOR I← XTTMUL,
XCHNGE, J
DO IPUSH(I);
BDESTS[0]←βEXPR$;
FOR I←1 STEP 1 UNTIL NFDEST
DO BEGIN INTEGER I1;
FOR I1←XGTVAL,J,XTTMUL, XCHNGE,J+I DO IPUSH(I1);
BDESTS[I]←$APPEND(FDESTS[I],βEXPR$,0);
END;
PTR[1]←$AAPPEND(BDESTS);
PTR[2]←EXPR$2(XRJMP);
FOR I←BARMSB,0,0,0 DO IPUSH(I);
FOR I←1 STEP 1 UNTIL NFDEST DO
BEGIN
IPUSH(J+I); IPUSH(0);IPUSH(0)
END;
IPUSH(0);
PTR[3]←βEXPR$;
EXPR$:BODY[PTR[2]][2]←EXPR$OFF(PTR,3,3);
FOR I←XRPMOVE, - (EXPR$:#BODY[PTR[3]]+1),
BARM_MECH,0,5,-1
DO IPUSH(I); ! last three zeros for error bits,
addrs next pcode,
retry addrs(to be inserted later);
PTR[4]←βEXPR$;
PPTR←$AAPPEND(PTR);
RETURN(PPTR);
END;
INTERNAL RPTR(EXPR$) PROCEDURE $CENTERPCODE(INTEGER ARM);
BEGIN "CENTER"
INTEGER I;
RPTR(EXPR$) PTR;
FOR I←XRJMP,8,
(IF ARM=BLUE THEN (BARMSB+BHANDSB) ELSE (YHANDSB+YARMSB)),
0,0,0,0,0,0,
XRCENTER,- 8,
(IF ARM=BLUE THEN BARM_MECH+BHAND_MECH ELSE YARM_MECH+YHAND_MECH),
0,5,-1
DO IPUSH(I); ! last three zeroes as for movepcode;
PTR←βEXPR$;
RETURN(PTR);
END "CENTER";
! control pcodes: if,for,while,do,case;
INTERNAL RPTR(EXPR$)PROCEDURE $IFPCODE(RPTR(EXPR$) COND,A,B(NULL));
BEGIN
RPTR(EXPR$)ARRAY IFP[1:6];
IFP[1]←COND;
IFP[2]←EXPR$2(XRJMPC);
IFP[3]←A;
IFP[4]←EXPR$2(XRJMP);
IFP[5]←IF B THEN B ELSE EXPR$1(XNOOP);
IFP[6]←EXPR$1(XNOOP);
EXPR$:BODY[IFP[2]][2]←EXPR$OFF(IFP,3,4);
EXPR$:BODY[IFP[4]][2]←EXPR$OFF(IFP,5,5);
RETURN($AAPPEND(IFP));
END;
INTERNAL RPTR(EXPR$)PROCEDURE $WHILEPCODE(RPTR(EXPR$)COND,STAT);
BEGIN
RPTR(EXPR$)ARRAY WHP[1:5];
WHP[1]←COND;
WHP[2]←EXPR$2(XRJMPC);
WHP[3]←STAT;
WHP[4]←EXPR$2(XRJMP);
WHP[5]←EXPR$1(XNOOP);
EXPR$:BODY[WHP[2]][2]←EXPR$OFF(WHP,3,4);
EXPR$:BODY[WHP[4]][2]←-EXPR$OFF(WHP,1,3);
RETURN($AAPPEND(WHP));
END;
INTERNAL RPTR(EXPR$)PROCEDURE $DOPCODE(RPTR(EXPR$)S,B);
BEGIN
RPTR(EXPR$)ARRAY DOP[1:3];
DOP[1]←S;
DOP[2]←B;
DOP[3]←EXPR$2(XRJMPC,-EXPR$OFF(DOP,1,2));
RETURN($AAPPEND(DOP));
END;
INTERNAL RPTR(EXPR$)PROCEDURE $FORPCODE(RPTR(SYMBOL)K;RPTR(EXPR$)I1,I2,I3,S);
BEGIN
RPTR(EXPR$) ARRAY FORP[1:9]; INTEGER I;
FORP[1]←I1;
FORP[2]←I3;
FORP[3]←I2;
FOR I←XCOPY,2 DO IPUSH(I);
CPUSH(K);
FORP[4]←βEXPR$;
FORP[5]←EXPR$2(XRFRCHK);
FORP[6]←S;
FOR I←XCOPY,0,XCOPY,3,XSADD,XREPLAC,3 DO IPUSH(I);
FORP[7]←βEXPR$;
FORP[8]←EXPR$2(XRJMP);
FORP[9]←EXPR$3(XPOP,XPOP,XPOP);
EXPR$:BODY[FORP[8]][2]←-EXPR$OFF(FORP,4,7);
EXPR$:BODY[FORP[5]][2]←EXPR$OFF(FORP,6,8);
RETURN($AAPPEND(FORP));
END;
INTERNAL RPTR(EXPR$)PROCEDURE $CASEPCODE(RPTR(EXPR$) EXI;RPTR(CASE$) EXC;
BOOLEAN READELSE;INTEGER MAXNUM);
BEGIN
RPTR(EXPR$) ARRAY EX1[1: 2*(MAXNUM+1)+6]; ! ????;
INTEGER ARRAY BUFFLAB[1: MAXNUM+2];
RPTR(CASE$)TEMP;
INTEGER OFFSET,I,CASEADDR,J,TEMPLAB;
EX1[1]←EXI; ! index;
IF READELSE THEN EX1[2]←EXPR$2(XRCASE, -(MAXNUM+1))
ELSE EX1[2]←EXPR$2(XRCASE, MAXNUM+1); ! XCASE and range;
! generate label list in bufflab and expressions;
TEMP←EXC;
! initial offset: max+2 (=labels) + 2 (rjmp,exit label);
OFFSET←MAXNUM+4;
I←5;
DO BEGIN
IF (CASEADDR←CASE$:NUM[TEMP])=#ELSE
THEN CASEADDR←MAXNUM+1;
BUFFLAB[CASEADDR+1]←OFFSET; ! computes labels;
OFFSET←OFFSET+EXPR$:#BODY[CASE$:BODY[TEMP]]+2;
EX1[I]←CASE$:BODY[TEMP]; ! statement;
EX1[I+1]←EXPR$2(XRJMP,-OFFSET+ MAXNUM+3); ! xrjmp + label;
I←I+2;
TEMP←CASE$:NEXT[TEMP]; ! next records;
WHILE TEMP≠NULL!RECORD AND
CASE$:BODY[TEMP]=NULL!RECORD DO
BEGIN
BUFFLAB[(IF CASE$:NUM[TEMP]=#ELSE THEN MAXNUM+1
ELSE CASE$:NUM[TEMP]) + 1]
←BUFFLAB[CASEADDR+1]; ! computes labels;
TEMP←CASE$:NEXT[TEMP]; ! next records;
END;
END
UNTIL TEMP=NULL!RECORD ;
! fill up the label list;
TEMPLAB←IF READELSE THEN BUFFLAB[MAXNUM+2] ELSE OFFSET;
FOR J←1 STEP 1 UNTIL MAXNUM+2
DO IF BUFFLAB[J]=0 THEN BUFFLAB[J]←TEMPLAB;
! bufflab[1: i];
EX1[3]←αEXPR$(BUFFLAB);
EX1[4]←EXPR$2(XRJMP,OFFSET-(MAXNUM+3)); ! jump exit;
RETURN($AAPPEND(EX1));
END;
! cobegpcode;
INTERNAL RPTR(EXPR$)PROCEDURE $COBEGPCODE(RPTR(EXPR$)ARRAY STATEMENTS);
BEGIN ! outputting the following:
0$: RJMP $X-0$-1
1$: STATEMENT 1
TERMINATE
2$: STATEMENT 2
TERMINATE
...
N$: STATEMENT N
TERMINATE
$X: XSPROUT
$X+1: N (i.e. # of statements)
$Y: 1$-$Y
0
2$-$Y
0
..
N$-$Y
0
0
;
RPTR(EXPR$) ARRAY PTR[0:ARRINFO(STATEMENTS,2)+1];
RPTR(EXPR$) E;
INTEGER #ARRSIZE,I;
#ARRSIZE←ARRINFO(STATEMENTS,2);
FOR I←1 STEP 1 UNTIL #ARRSIZE
DO PTR[I]←$APPEND(STATEMENTS[I],EXPR$1(XTERMINATE));
E←PTR[#ARRSIZE+1]←NEXPR(#ARRSIZE*2+3,XPSPROUT);
EXPR$:BODY[E][2]←#ARRSIZE;
FOR I←1 STEP 1 UNTIL #ARRSIZE
DO EXPR$:BODY[E][2*I+1]←-EXPR$OFF(PTR,I,#ARRSIZE)-1;
PTR[0]←EXPR$2(XRJMP,EXPR$OFF(PTR,1,#ARRSIZE));
RETURN($AAPPEND(PTR));
END;
! arrdclpcode,prcdclpcode,rtnpcode,smpdclpcode;
INTERNAL RPTR(EXPR$)PROCEDURE $SMPDCLPCODE(INTEGER OBTYPE,J);
BEGIN
INTEGER I;
FOR I←XMVAR, OBTYPES[OBTYPE], J, 0 DO IPUSH(I);
RETURN(βEXPR$(OBTYPE));
END;
INTERNAL RPTR(EXPR$)PROCEDURE $KVARPCODE(INTEGER N);
IF N>0 THEN RETURN(EXPR$2(XKVAR,N)) ELSE RETURN(EXPR$1(XNOOP));
INTERNAL RPTR(EXPR$)PROCEDURE $RTNPCODE(RPTR(EXPR$)EE);
BEGIN
RPTR(EXPR$)E;
INTEGER I,TYP,VAL;
IF EE=NULL!RECORD THEN
BEGIN VAL←0; TYP←#PR END
ELSE BEGIN VAL←#MINUS1; TYP←EXPR$:TYPE[EE]; END;
FOR I←XRETURN,VAL DO IPUSH(I);
E←βEXPR$;
E←$APPEND(EE,E,TYP);
RETURN(E);
END;
INTERNAL RPTR(EXPR$)PROCEDURE $PRCDCLPCODE(RPTR(SYMBOL)SYM; RPTR(EXPR$)PBODY);
BEGIN
INTEGER NARGS,ENV;
RPTR(EXPR$) ARRAY PTR[1:5];
RPTR(EXPR$)PPTR;
RPTR(PROC)P;
INTEGER I,IPC;
INTEGER OBTYPE;
OBTYPE←SYMBOL:TYPE[SYM];
NARGS←PROC:NARGS[P←SYMBOL:OBJECT[SYM]];
ENV←NARGS; ! include the local variables too ;
IPC← - 1 ; ! dummy to get PPCODE to print out ;
PTR[1]←EXPR$2(XGTBLK);
PTR[2]←PBODY;
PTR[3]←EXPR$2(XRETURN);
IF SYMBOL:TYPE[CURPROC]≠#PR THEN EXPR$:BODY[PTR[3]][2]←#MINUS1;
EXPR$:BODY[PTR[1]][2]←EXPR$OFF(PTR,2,3)-1;
PTR[4]←EXPR$1(5);
FOR I←XMVAR,#PRCTYP,1,NARGS,IPC,ENV+30 DO IPUSH(I);
FOR I←1 STEP 1 UNTIL NARGS DO IPUSH(PROC:ARGACCS[P][I]
+OBTYPES[PROC:ARGTYPE[P][I]]);
IPUSH(0); ! indicate end of mvar pcode;
PTR[5]←βEXPR$(OBTYPE); ! this is the procedure header ;
PPTR←$AAPPEND(PTR);
RETURN(PPTR);
END;
RPTR(EXPR$) PROCEDURE ARRDCLPCODE0(RPTR(EXPR$)ARRAY BOUNDS;
INTEGER OBTYPE,ADIM,OFFSET);
BEGIN
RPTR(EXPR$) ARRAY $BOUNDS[1:4*ADIM+1];
RPTR(EXPR$) PTR; RPTR(SYMBOL)S; RPTR(ARRAYREC)A;
INTEGER I,I1,I2,J;
J←$TSCOFF-1; I2←0;
FOR I←1 STEP 1 UNTIL 2*ADIM DO
BEGIN
$BOUNDS[I2←I2+1]←BOUNDS[I];
FOR I1←XCHNGE,J+I DO IPUSH(I1);
$BOUNDS[I2←I2+1]←βEXPR$;
END;
FOR I1←XMVAR,#ARRTYP + OBTYPES[OBTYPE],ADIM DO IPUSH(I1);
FOR I1←2 STEP 2 UNTIL ADIM*2 DO BEGIN IPUSH(J+I1); IPUSH(J+I1-1); END;
IPUSH(0);
$BOUNDS[I2←I2+1]←βEXPR$;
PTR←$AAPPEND($BOUNDS,OBTYPE);
RETURN(PTR);
END;
INTERNAL RPTR(EXPR$) PROCEDURE $ARRDCLPCODE(RPTR(EXPR$)ARRAY BOUNDS;
INTEGER OBTYPE,ADIM,OFFSET);
BEGIN INTEGER I1;
RPTR(EXPR$)A1,A2;
A1←ARRDCLPCODE0(BOUNDS,OBTYPE,ADIM,OFFSET);
FOR I1←XARRINI,OFFSET DO IPUSH(I1);
A2←βEXPR$;
RETURN($APPEND(A1,A2));
END;
! load,dump pcodes;
INTERNAL RPTR(EXPR$) PROCEDURE L$SIMPCODE(RPTR(SYMBOL)PTR;INTEGER TYPE;RPTR(EXPR$)EXP);
BEGIN
RANY OBJECT; RPTR (EXPR$) ARRAY BUF[1:5];
PRELOAD_WITH XPUSHSCI,XMKVT,XMKRT,XMKTR,XMKTR,XNOOP;
OWN INTEGER ARRAY LCODE[#SC:#EV];
OBJECT←SYMBOL:OBJECT[PTR];
IF TYPE=#EV THEN RETURN(NULL_RECORD)
ELSE BUF[1]←EXPR$1(LCODE[TYPE]);
BUF[2]←EXP;
IF TYPE=#FR AND FRAME:HOWLINKED[OBJECT]≠#INDLK
THEN BEGIN
BUF[3]←EXPR$ID(FRAME:SYM[FRAME:DAD[OBJECT]]);
BUF[4]←EXPR$ID(PTR);
BUF[5]←EXPR$2(XPAFFIX,
IF FRAME:HOWLINKED[OBJECT]≠#RGDLK
THEN #NONRGD ELSE 0);
END
ELSE BEGIN
BUF[3]←EXPR$ID(PTR);
BUF[4]←EXPR$1(XCHNGS);
END;
RETURN($AAPPEND(BUF,TYPE));
END;
RPTR(EXPR$) PROCEDURE L$ARRDCLPCODE(RPTR(SYMBOL)SYMPTR;INTEGER TYPE);
BEGIN
INTEGER I,ADIM;RPTR(ARRAYREC)OBJECT;
ADIM←ARRAYREC:#DIM[OBJECT←SYMBOL:OBJECT[SYMPTR]];
BEGIN
RPTR(EXPR$) ARRAY BOUNDS[1:10];
FOR I←1 STEP 1 UNTIL ADIM DO
BEGIN
BOUNDS[I*2-1]←EXPR$2(XPUSHINTI,ARRAYREC:LB[OBJECT][I]);
BOUNDS[I*2]←EXPR$2(XPUSHINTI,ARRAYREC:UB[OBJECT][I]);
END;
RETURN(ARRDCLPCODE0(BOUNDS,TYPE,ADIM,SYMBOL:OFFSET[SYMPTR]));
END;
END;
INTERNAL RPTR(EXPR$) PROCEDURE L$ARRPCODE(RPTR(SYMBOL)PTR;INTEGER TYPE;RPTR(EXPR$)EXP);
BEGIN
RPTR(EXPR$)ARRAY EXPR[1:3];RPTR(EXPR$)TEMP;
EXPR[1]←L$ARRDCLPCODE(PTR,TYPE);
EXPR[2]←EXPR$3(XARRLD,SYMBOL:OFFSET[PTR],TYPE);
EXPR[3]←EXP;
RETURN($AAPPEND(EXPR,TYPE));
END;
! wrist,setbase,gather,rforce,setstf,vt05pcode,sigwait;
INTERNAL RPTR(EXPR$)PROCEDURE $WRISTPCODE(RPTR(SYMBOL)S);
RETURN(EXPR$2(XWRIST,SYMBOL:OFFSET[S]));
INTERNAL RPTR(EXPR$)PROCEDURE $SETBASEPCODE;
RETURN(EXPR$1(XSETBAS));
INTERNAL RPTR(EXPR$)PROCEDURE $GATHERPCODE(INTEGER STATUS);
RETURN(EXPR$2(XGATHER,STATUS));
INTERNAL RPTR(EXPR$) PROCEDURE $RFORCEPCODE;
RETURN(EXPR$1(XRFORCE));
INTERNAL RPTR(EXPR$)PROCEDURE $SETSTFPCODE;
RETURN(EXPR$1(XSETSTF));
INTERNAL RPTR(EXPR$)PROCEDURE $STOPPCODE(INTEGER BITS);
RETURN(EXPR$2(XSTOP,BITS));
INTERNAL RPTR(EXPR$) PROCEDURE $VT05PCODE(INTEGER STATE);
RETURN(EXPR$2(XDISVT05,STATE));
INTERNAL RPTR(EXPR$) PROCEDURE $SIGWAITPCODE(RPTR(EXPR$) EVENT;BOOLEAN SIGNAL);
RETURN($APPEND(EVENT,EXPR$1(IF SIGNAL THEN XPSIGNAL ELSE XPWAIT)));
END "PCODE";